home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / p063b9s.zip / UNIT / FILEUTIL.PAS < prev    next >
Pascal/Delphi Source File  |  1997-03-02  |  10KB  |  357 lines
  1. UNIT FileUtil;
  2. {╔══════════════════════════════════════════════════════════════════════════╗}
  3. {║ Misc. file utilities                          Last changed: 02.03.97  SA ║}
  4. {║                                                                          ║}
  5. {║                         (C) Copyright 1989-97 by                         ║}
  6. {║       Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager        ║}
  7. {║                                                                          ║}
  8. {║ This source may not be given to anybody, without the written permission  ║}
  9. {║ from The Portal Team.                                                    ║}
  10. {╚══════════════════════════════════════════════════════════════════════════╝}
  11. {$I POPDEFS.INC}
  12.  
  13. INTERFACE
  14.  
  15. USES Use32, Dos,
  16.      NetFile;
  17.  
  18. PROCEDURE ReadLine(VAR f: File; VAR s: String);
  19. FUNCTION  ChangeDir(Dir: PathStr): Boolean;
  20. PROCEDURE RunCmd(CONST Cmd, SubDir: String);
  21. FUNCTION  UniqueName(FName: PathStr): PathStr;
  22. PROCEDURE TruncateFile(CONST FileName: PathStr);
  23. FUNCTION  DeleteFile(CONST FileName: PathStr): Boolean;
  24. FUNCTION  MakeTaskFileName(CONST InFile: PathStr): PathStr;
  25. PROCEDURE CloseFiles(Exit: Boolean);
  26. PROCEDURE OpenFiles(OpenLog: Boolean);
  27. PROCEDURE MakeFullDir(Dir: PathStr);
  28. FUNCTION  ChkDir(CONST s: PathStr): Boolean;
  29. FUNCTION  RenameFile(CONST OldName, NewName : PathStr) : Boolean;
  30. FUNCTION  FileCRC(CONST FName: PathStr): LongInt;
  31. FUNCTION  DriveSize(d: byte): LongInt; { -1 not found, 1GB >= 1 Giga }
  32. FUNCTION  DriveFree(d: byte): LongInt; { -1 not found, 1GB >= 1 Giga }
  33. FUNCTION  CopyFile(CONST f1, f2: PathStr; Touch, MoveIt: Boolean): Integer;
  34.  
  35. IMPLEMENTATION
  36.  
  37. USES OpCrt, OpWindow, OpDos, OpString,
  38.      PoPTypes, LogFile, InterCom, Resource, OproUtil, DosShell, Crc,
  39.      Globals, Util, StrUtil, Display;
  40.  
  41.   PROCEDURE ReadLine(VAR f: File; VAR s: String);
  42.   VAR
  43.     OldPos : LongInt;
  44.     Buf    : Array[0..254] Of Char;
  45.     Test   : Word;
  46.     i      : Byte;
  47.   BEGIN
  48.     S:='';
  49.     OldPos:=FilePos(f);
  50.     BlockRead(f, Buf, SizeOf(Buf), Test);
  51.     i:=0;
  52.     WHILE (Test<>0) And (i<Test) AND (Buf[i]<>#10) DO
  53.     BEGIN
  54.       IF (Buf[i]<>#10) AND (Buf[i]<>#13) THEN S:=S+Buf[i];
  55.       Inc(i);
  56.     END;
  57.     Seek(f, OldPos+i+1);
  58.     IF IoResult<>0 THEN ;
  59.   END;
  60.  
  61.   FUNCTION ChangeDir(Dir: PathStr): Boolean;
  62.   BEGIN
  63.     Dir:=ReplaceEnv(Dir);
  64.     IF (Length(Dir)>3) AND (Dir[Length(Dir)]='\') THEN Dec(Dir[0]) ELSE
  65.       IF (Length(Dir)=2) THEN Dir:=Dir+'\';
  66.     ChDir(Dir);
  67.     ChangeDir:=(IOResult=0);
  68.   END;
  69.  
  70.   FUNCTION FileCRC(CONST FName: PathStr): LongInt;
  71.   VAR
  72.     f   : FILE;
  73.     c   : LongInt;
  74.     buf : Pointer;
  75.     i, BufSize, Test : Word;
  76.     Gauge : PGauge;
  77.   BEGIN
  78.     c:=$FFFFFFFF;
  79.     Assign(f,FName); FileMode:=ShareRead+ShareDenyW; Reset(f,1);
  80.     IF IOResult=0 THEN
  81.     BEGIN
  82.       New(Gauge, Init((ScreenHeight DIV 2)-2, 2, 'Calculating CRC on: '+JustFileName(FName), FileSize(f)));
  83.       BufSize:=8192 {Max64k(MaxAvail-1024)};
  84.       GetMem(Buf,BufSize);
  85.       IF (Gauge<>NIL) AND (Buf<>NIL) THEN
  86.       BEGIN
  87.         WHILE NOT EoF(f) DO
  88.         BEGIN
  89.           BlockRead(f, buf^, BufSize, Test);
  90.           FOR i:=1 TO Test DO
  91.             c:=UpdCRC32(BT(Buf^)[i],c);
  92.           Gauge^.Update(FilePos(f));
  93.         END;
  94.       END ELSE
  95.         AddLog('!', 'Not enough memory to calculate CRC on: '+FName);
  96.       IF Buf<>NIL THEN FreeMem(Buf,BufSize);
  97.       IF Gauge<>NIL THEN Dispose(Gauge, Done);
  98.       Close(f);
  99.     END;
  100.     FileCRC:=NOT c;
  101.   END;
  102.  
  103.   PROCEDURE RunCmd(CONST Cmd, SubDir: String);
  104.   VAR
  105.     SaveDir : PathStr;
  106.     Tmp     : WindowPtr;
  107.     i       : Integer;
  108.   BEGIN
  109.     AddLog(' ','Running: '+Cmd);
  110.     GetDir(0,SaveDir);
  111.     ChangeDir(SubDir);
  112.     MyWin(Tmp,1,1,80,ScreenHeight,0,'',False);
  113.     Writeln('Running: ',Cmd);
  114.     IF Cfg.SwapOnExec THEN
  115.     BEGIN
  116.       i:=ShellToDos(GetEnv('COMSPEC'),'/C '+Cmd,False);
  117.     END ELSE
  118.     BEGIN
  119.       i:=ExecDos(Cmd,True,NoExecDosProc);
  120.     END;
  121.     IF i<>0 THEN AddLog('!','Error '+Long2Str(i)+' running: '+Cmd);
  122.     KillWindow(Tmp);
  123.     ChangeDir(SaveDir);
  124.   END;
  125.  
  126.   FUNCTION UniqueName(FName: PathStr): PathStr;
  127.   VAR
  128.     n    : Byte;
  129.   BEGIN
  130.     n := 1;
  131.     WHILE ExistFile(FName) DO
  132.     BEGIN
  133.       FName:=Copy(FName, 1, Length(FName)-Length(Long2Str(n)))+Long2Str(n);
  134.       Inc(n);
  135.     END;
  136.     UniqueName:=FName;
  137.   END;
  138.  
  139.   PROCEDURE TruncateFile(CONST FileName: PathStr);
  140.   VAR
  141.     Dummy          : FILE;
  142.   BEGIN
  143.     Assign(Dummy, FileName);
  144.     Rewrite(Dummy);
  145.     IF IoResult = 0 THEN Close(Dummy);
  146.   END;
  147.  
  148.   FUNCTION DeleteFile(CONST FileName: PathStr) : Boolean;
  149.   VAR
  150.     Dummy          : FILE;
  151.   BEGIN
  152.     Assign(Dummy, FileName);
  153.     Erase(Dummy);
  154.     DeleteFile:=(IoResult=0);
  155.   END;
  156.  
  157.   PROCEDURE CloseFiles(Exit: Boolean);
  158.   BEGIN
  159.     ClosePortalLog(Exit);
  160.     CloseInterCom;
  161.     CloseResLib;
  162.   END;
  163.  
  164.   FUNCTION ChkDir(CONST s: PathStr): Boolean;
  165.   VAR
  166.     g : PathStr;
  167.   BEGIN
  168.     GetDir(0, g);
  169.     ChkDir:=ChangeDir(s);
  170.     ChDir(g);
  171.   END;
  172.  
  173.   FUNCTION MakeTaskFileName(CONST InFile: PathStr): PathStr;
  174.   VAR
  175.     FileName, Path : PathStr;
  176.     Ext            : String[4];
  177.   BEGIN
  178.     IF Cfg.TaskNumber=0 THEN
  179.       MakeTaskFileName:=InFile
  180.     ELSE
  181.     BEGIN
  182.       FileName:=JustFileName(InFile);
  183.       Path:=JustPathName(InFile);
  184.       IF Length(Path)>0 THEN Path:=Path+'\';
  185.       Ext:=Copy(FileName,Pos('.',FileName),Length(FileName)-Pos('.',FileName)+1);
  186.       FileName:=Copy(FileName,1,Pos('.',FileName)-1);
  187.       IF Length(FileName)>6 THEN FileName:=Copy(FileName,1,6);
  188.       IF Cfg.HexTask THEN
  189.         FileName:=FileName+HexB(Cfg.TaskNumber)
  190.       ELSE
  191.         FileName:=FileName+LongIntForm('@@', Cfg.TaskNumber);
  192.       MakeTaskFileName:=Path+FileName+Ext;
  193.     END;
  194.   END;
  195.  
  196.   PROCEDURE MakeFullDir(Dir: PathStr);
  197.   VAR
  198.     a : Byte;
  199.   BEGIN
  200.     Dir:=AddBackSlash(Dir);
  201.     FOR a:=2 TO Length(Dir) DO
  202.       IF Dir[a]='\' THEN
  203.       BEGIN
  204.         MkDir(Copy(Dir,1,a-1));
  205.         IF IOResult=0 THEN ;
  206.       END;
  207.   END;
  208.  
  209.   FUNCTION RenameFile(CONST OldName, NewName : PathStr) : Boolean;
  210.   VAR
  211.     f : FILE;
  212.   BEGIN
  213.     Assign(f, OldName);
  214.     Rename(f, NewName);
  215.     RenameFile := (IoResult = 0);
  216.   END;
  217.  
  218.   PROCEDURE OpenFiles(OpenLog: Boolean);
  219.   BEGIN
  220.     IF OpenLog THEN OpenPortalLog;
  221.     OpenResLib(StartPath+PoPResourceFileName);
  222.     IF Not OpenInterCom(Cfg.TaskNumber,cfg.Addresses[Cfg.MainAdrNum]) THEN Halt(250);
  223.   END;
  224.  
  225. {$IFDEF OS2}
  226.   Function DriveSize(d:byte): Longint;
  227.   BEGIN
  228.     DriveSize:=DiskSize(d);
  229.   END;
  230.  
  231.   Function DriveFree(d:byte): Longint;
  232.   BEGIN
  233.     DriveFree:=DiskFree(d);
  234.   END;
  235.  
  236. {$ELSE}
  237.  
  238.   Function DriveSize(d:byte):Longint; { -1 not found, 1=>1 Giga }
  239.   VAR
  240.     R : Registers;
  241.   Begin
  242.     With R Do
  243.     Begin
  244.       ah:=$36;
  245.       dl:=d;
  246.       Intr($21,R);
  247.       If AX=$FFFF Then
  248.         DriveSize:=-1 { Drive not found }
  249.       Else
  250.         If (DX=$FFFF) or (Longint(ax)*cx*dx=1073725440) Then
  251.           DriveSize:=1073725440
  252.         Else
  253.           DriveSize:=Longint(ax)*cx*dx;
  254.     End;
  255.   End;
  256.  
  257.   Function DriveFree(d:byte):Longint;
  258.   VAR
  259.     R : Registers;
  260.   Begin
  261.     With R Do
  262.     Begin
  263.       ah:=$36;
  264.       dl:=d;
  265.       Intr($21, R);
  266.       If AX=$FFFF Then
  267.         DriveFree:=-1 { Drive not found }
  268.       Else
  269.         If (BX=$FFFF) or (Longint(ax)*bx*cx=1073725440) Then
  270.           DriveFree:=1073725440
  271.         Else
  272.           DriveFree:=Longint(ax)*bx*cx;
  273.     End;
  274.   END;
  275. {$ENDIF}
  276.  
  277.   FUNCTION CopyFile(CONST f1,f2 : PathStr; Touch,MoveIt: Boolean): Integer;
  278.   LABEL
  279.     EndCopy;
  280.   VAR
  281.     ind,ud            : FILE;
  282.     Sr                : SearchRec;
  283.     num,res,bufsiz    : Word;
  284.     fsize,time, dfree : LongInt;
  285.     buf               : Pointer;
  286.     FileWin,DiskWin   : PGauge;
  287.     io                : Integer;
  288.   BEGIN
  289.     IF MoveIt AND (StUpCase(f1[1])=StUpCase(f2[1])) THEN
  290.     BEGIN
  291.       DeleteFile(f2);
  292.       IF RenameFile(f1,f2) THEN Io:=0 ELSE Io:=5;
  293.     END ELSE
  294.     BEGIN
  295.       IF MaxAvail>65521+2048 THEN bufsiz:=65521 ELSE bufsiz:=MaxAvail-2048;
  296.       GetMem(buf,bufsiz);
  297.       Assign(ind,f1); FileMode:=ShareRead+ShareDenyW;
  298.       Reset(ind,1);
  299.       fsize:=FileSize(ind);
  300.       dfree:=DriveFree(ORD(UpCase(f2[1]))-64);
  301.       New(FileWin,Init(8,3,'Copying file '+JustFileName(f1),fsize));
  302.       New(DiskWin,Init(12,3,'Free space on drive '+f2[1],DriveSize(Ord(UpCase(f2[1]))-64)));
  303.       IF fsize+2048>dfree THEN
  304.       BEGIN
  305.         IF dfree=-1 THEN
  306.         BEGIN
  307.           FindFirst(f2,AnyFile,sr);
  308.           io:=DosError;
  309.           FindClose(sr);
  310.         END ELSE
  311.           io:=5;
  312.         GOTO EndCopy;
  313.       END;
  314.       Assign(ud,f2);
  315.       Rewrite(ud,1);
  316.       io:=IoResult;
  317.       IF io=0 THEN
  318.       BEGIN
  319.         WHILE NOT EOF(ind) DO
  320.         BEGIN
  321.           IF FileWin<>NIL THEN FileWin^.Update(FileSize(ud));
  322.           DiskWin^.Update(DriveFree(Ord(f2[1])-64));
  323.           BlockRead(ind,buf^,bufsiz,num);
  324.           io:=IoResult;
  325.           IF io<>0 THEN
  326.           BEGIN
  327.             io:=3;
  328.             GOTO EndCopy;
  329.           END ELSE
  330.           BEGIN
  331.             BlockWrite(ud,buf^,num,res);
  332.             io:=IoResult;
  333.             IF (io<>0) OR (num<>res) THEN
  334.             BEGIN
  335.               io:=4;
  336.               GOTO EndCopy;
  337.             END;
  338.           END;
  339.         END;
  340.         IF FileWin<>NIL THEN FileWin^.Update(FileSize(ud));
  341.         DiskWin^.Update(DriveFree(Ord(f2[1])-64));
  342.         GETFTIME(ind,Time);
  343.         IF Not Touch THEN SetFTime(ud,Time);
  344.         Close(ud);
  345.       END;
  346.   EndCopy:
  347.       Close(ind);
  348.       IF (Io=0) AND MoveIt THEN DeleteFile(f1);
  349.       FreeMem(buf,bufsiz);
  350.       Dispose(DiskWin,Done);
  351.       IF FileWin<>NIL THEN Dispose(FileWin,Done);
  352.     END;
  353.     CopyFile:=Io;
  354.   END;
  355.  
  356. END.
  357.